home *** CD-ROM | disk | FTP | other *** search
/ CD Ware Multimedia 1995 May / cd Ware (Juegos) Epimundo.iso / DOS / PRGMMING / PBC30.ZIP / FORMDATE.BAS < prev    next >
Encoding:
BASIC Source File  |  1994-11-12  |  2.6 KB  |  89 lines
  1. '   +----------------------------------------------------------------------+
  2. '   |                                                                      |
  3. '   |        PBClone  Copyright (c) 1990-1994  Thomas G. Hanlin III        |
  4. '   |                                                                      |
  5. '   +----------------------------------------------------------------------+
  6.  
  7.  
  8.    DECLARE SUB CheckDate (BYVAL MonthNr%, BYVAL DayNr%, BYVAL YearNr%, ErrCode%)
  9.    DECLARE SUB TInstr (St$, BYVAL ChrType%, Place%)
  10.  
  11. SUB FormatDate (DateSt$, FormatSt$, Result$, ErrCode%)
  12.    ErrCode% = -1
  13.  
  14.    IF LEN(DateSt$) THEN
  15.       Dt$ = DateSt$
  16.    ELSE
  17.       Dt$ = DATE$
  18.    END IF
  19.  
  20.    IF LEN(FormatSt$) THEN
  21.       DateFormat$ = UCASE$(FormatSt$)
  22.    ELSE
  23.       DateFormat$ = "MM/DD/YY"
  24.    END IF
  25.  
  26.    MonthNr% = CINT(VAL(Dt$))
  27.    TInstr Dt$, NOT 2, Place%
  28.    IF Place% = 0 THEN EXIT SUB
  29.    Dt$ = MID$(Dt$, Place% + 1)
  30.    DayNr% = CINT(VAL(Dt$))
  31.    TInstr Dt$, NOT 2, Place%
  32.    IF Place% = 0 THEN EXIT SUB
  33.    Dt$ = MID$(Dt$, Place% + 1)
  34.    YearNr% = CINT(VAL(Dt$))
  35.    IF YearNr% < 100 THEN YearNr% = YearNr% + 1900
  36.  
  37.    CheckDate MonthNr%, DayNr%, YearNr%, ErrCode%
  38.    IF ErrCode% THEN EXIT SUB
  39.  
  40.    tmp$ = DateFormat$
  41.    DO
  42.       ch$ = LEFT$(tmp$, 1)
  43.       IF INSTR("MDY#", ch$) = 0 THEN Delim$ = ch$
  44.       tmp$ = MID$(tmp$, 2)
  45.    LOOP UNTIL LEN(Delim$) > 0 OR LEN(tmp$) = 0
  46.  
  47.    IF LEN(Delim$) = 0 AND INSTR(DateFormat$, "#") > 0 THEN
  48.       IF LEN(DateFormat$) = 6 THEN
  49.          DateFormat$ = "MMDDYY"
  50.       ELSE
  51.          DateFormat$ = "MMDDYYYY"
  52.       END IF
  53.    END IF
  54.  
  55.    IF INSTR(DateFormat$, "####") OR INSTR(DateFormat$, "YYYY") THEN
  56.       YearLen% = 4
  57.    ELSE
  58.       YearLen% = 2
  59.    END IF
  60.  
  61.    M% = INSTR(DateFormat$, "M")
  62.    D% = INSTR(DateFormat$, "D")
  63.    Y% = INSTR(DateFormat$, "Y")
  64.    IF M% > 0 AND D% > 0 AND Y% > 0 THEN
  65.       MM% = 1 - ((M% > D%) + (M% > Y%))
  66.       DD% = 1 - ((D% > M%) + (D% > Y%))
  67.       YY% = 1 - ((Y% > M%) + (Y% > D%))
  68.       Order$ = "xxx"
  69.       MID$(Order$, MM%, 1) = "M"
  70.       MID$(Order$, DD%, 1) = "D"
  71.       MID$(Order$, YY%, 1) = "Y"
  72.    ELSE
  73.       Order$ = "MDY"
  74.    END IF
  75.  
  76.    Result$ = ""
  77.    FOR tmp% = 1 TO 3
  78.       SELECT CASE MID$(Order$, tmp%, 1)
  79.          CASE "M"
  80.             Result$ = Result$ + Delim$ + RIGHT$("0" + MID$(STR$(MonthNr%), 2), 2)
  81.          CASE "D"
  82.             Result$ = Result$ + Delim$ + RIGHT$("0" + MID$(STR$(DayNr%), 2), 2)
  83.          CASE "Y"
  84.             Result$ = Result$ + Delim$ + RIGHT$("000" + MID$(STR$(YearNr%), 2), YearLen%)
  85.       END SELECT
  86.    NEXT
  87.    IF LEN(Delim$) THEN Result$ = MID$(Result$, 2)
  88. END SUB
  89.